home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / util / rexx / cliped16.lha / cliped / cliped.rexx < prev   
OS/2 REXX Batch file  |  1997-08-15  |  10KB  |  343 lines
  1. /*
  2. ** $VER: cliped.rexx 1.5 (17.5.97) Rolf Rotvel
  3. **
  4. ** Uses rexxreqtools.library
  5. */
  6.  
  7. call addlib('rexxreqtools.library', 0, -30, 0)
  8. call addlib('rexxsupport.library', 0, -30, 0)
  9.  
  10. nl = '0a'x
  11. cr = '0d'x
  12. sep = '¤'
  13.  
  14. title = subword(sourceline(2), 3, 2)
  15.  
  16. call get_clips()
  17.  
  18. do forever
  19.     ans = rtezrequest(mainbody, maingads, title)
  20.  
  21.     select
  22.         when ans = 0 then exit
  23.         when ans = 1 then do
  24.             if numclips = 0 then call create_clip()
  25.             else do
  26.                 if numclips > 1 then num = rxlistview(300, 200, 'Select clip to edit')   
  27.                 else num = 1
  28.                 if num ~= 0 then call view_clip(num)
  29.             end
  30.         end
  31.         when ans = 2 then call create_clip()
  32.         otherwise exit 10
  33.     end
  34. end
  35.  
  36.  
  37. GET_CLIPS:
  38. clipnames = show('c',, sep)
  39.  
  40. if clipnames ~= '' then do
  41.     c = 1
  42.     len = 0
  43.     do forever
  44.         parse var clipnames clip.name.c (sep) clipnames
  45.  
  46.         if clip.name.c = '' then leave  /* No more clips */
  47.  
  48.         clip.value.c = checklf(getclip(clip.name.c))    /* Check clips for lf/cr */
  49.  
  50.         len = max(len, length(clip.name.c))
  51.         c = c + 1
  52.     end
  53.     numclips = c - 1
  54.  
  55.     do f = 1 to numclips
  56.         viewline.f = left(clip.name.f, len)||' : '||clip.value.f
  57.     end
  58.  
  59.     if numclips = 1 then ext = 'entry'
  60.     else ext = 'entries'
  61.  
  62.     maingads = '_Edit clip list|_Create new clip|_Quit'
  63.     mainbody = numclips||' '||ext||' '||'in clip list'
  64. end
  65. else do
  66.     numclips = 0
  67.  
  68.     maingads = 'Create _new clip|_Quit'
  69.     mainbody = 'Clip list is empty'
  70. end
  71. viewline.0 = numclips
  72. return
  73.  
  74.  
  75. VIEW_CLIP: 
  76. arg clipnum
  77.  
  78. body = 'Name  : '||clip.name.clipnum||nl||'Value : '||clip.value.clipnum
  79. gads = '_Edit clip|_Delete clip|_Cancel'
  80.  
  81. ans = rtezrequest(body, gads, title)
  82.  
  83. select
  84.     when ans = 0 then return
  85.     when ans = 1 then call edit_clip(clipnum)
  86.     when ans = 2 then call delete_clip(clipnum)
  87.     otherwise exit 10
  88. end
  89. return
  90.  
  91.  
  92. EDIT_CLIP: 
  93. arg clipnum
  94. body = 'Enter new value for '||clip.name.clipnum
  95.  
  96. ans = rtgetstring(clip.value.clipnum, body, title)
  97. if rtresult = 0 | ans = '' then return
  98.  
  99. if confirm('Use this value?', clip.name.clipnum, ans) then do
  100.     call setclip(clip.name.clipnum, addlf(ans))     /* Convert \nl \cr -> nl cr */
  101.     call get_clips()
  102. end                                
  103. return
  104.  
  105.  
  106. DELETE_CLIP: 
  107. arg clipnum
  108.  
  109. if confirm('Delete this clip?', clip.name.clipnum, clip.value.clipnum) then do
  110.     call setclip(clip.name.clipnum, '')
  111.     call get_clips()
  112. end                                
  113. return
  114.  
  115.  
  116. CREATE_CLIP: 
  117. newname = rtgetstring(, 'Enter the name of the new clip', title)
  118. if rtresult = 0 | newname = '' then return
  119.  
  120. chkvalue = getclip(newname)
  121. if chkvalue ~= '' then do
  122.     do clipcount = 1 to numclips
  123.         if clip.name.clipcount = newname then leave
  124.     end
  125.     if confirm('Clip already exists! Change value?', clip.name.clipcount, clip.value.clipcount) then do
  126.         call edit_clip(clipcount)
  127.     end
  128.     return
  129. end
  130.  
  131. newvalue = rtgetstring(, 'Enter the value of the new clip', title)
  132. if rtresult = 0 | newvalue = '' then return
  133.  
  134. if confirm('Create this clip?', newname, newvalue) then do
  135.     call setclip(newname, addlf(newvalue))
  136.     call get_clips()
  137. end
  138. return
  139.  
  140.  
  141. CONFIRM: procedure expose title nl
  142. parse arg txt, name, value
  143.  
  144. body = txt||nl||'Name  : '||name||nl||'Value : '||value
  145. gads = '_Ok|_Cancel'
  146.  
  147. if rtezrequest(body, gads, title) then return 1
  148. return 0
  149.  
  150.  
  151. RXLISTVIEW: procedure expose viewline. rxlv.
  152. parse arg argwidth, argheight, titletxt
  153.  
  154. /* Initialize when listview is opened for the first time */
  155. if rxlv.init? ~= 1 then call init_rxlistview(argwidth, argheight)
  156.  
  157. /* Create formatted stem variable for listview */
  158. do v = 1 to viewline.0
  159.     displine.v = left(viewline.v, rxlv.dispcols)
  160. end
  161. displine.0 = viewline.0
  162. /* Which is bigger - win rows or lines in stemvar? */
  163. if rxlv.disprows > displine.0 then rxlv.disprows = displine.0
  164.  
  165. /* Get current mouse coordinates */
  166. intui = showlist(l, 'intuition.library',, a)
  167. call forbid
  168. screen = next(intui, 56)                              /* IntuitionBase->ActiveScreen */
  169. mousex = c2d(import(offset(screen, 18), 2)) - 50      /* Screen->MouseX */
  170. mousey = c2d(import(offset(screen, 16), 2)) - 50      /* Screen->MouseY */
  171. call permit
  172.  
  173. /* Open the listview */
  174. call open('listwin', 'RAW:'||mousex||'/'||mousey||'/'||rxlv.width||'/'||rxlv.height||'/'||titletxt||'/NOSIZE', 'w')
  175. call writech('listwin', rxlv.nocursor||rxlv.nowordwrap)
  176.  
  177. /* Do ze stuff */
  178. row = 1 ; var = row 
  179. call writech('listwin', getlighty(row, var)||rxlv.nl||getpage(var + 1))
  180.  
  181. res = '' ; topvar = 1 
  182. do forever
  183.     oldrow = row ; oldvar = var
  184.     char = readch('listwin', 1)
  185.     select
  186.         when char = rxlv.csi then do
  187.             char = readch('listwin', 1)
  188.             select
  189.                 when char = rxlv.cursordown & oldvar ~= displine.0 then do
  190.                     line = getunlighty(oldrow, oldvar)
  191.                     var = var + 1
  192.                     if oldrow < rxlv.disprows then row = row + 1 
  193.                     else do
  194.                         line = line||rxlv.nl
  195.                         row = rxlv.disprows
  196.                         topvar = topvar + 1
  197.                     end
  198.                     call writech('listwin', line||getlighty(row, var))
  199.                 end  
  200.                 when char = rxlv.cursorup & oldvar ~= 1 then do
  201.                     line = getunlighty(oldrow, oldvar)
  202.                     var = var - 1
  203.                     if oldrow ~= 1 then do
  204.                         row = row - 1
  205.                         call writech('listwin', line||getlighty(row, var))
  206.                     end
  207.                     else do
  208.                         row = 1 
  209.                         topvar = topvar - 1
  210.                         call writech('listwin', line||getlighty(row, var)||rxlv.nl||getpage(var + 1))
  211.                     end            
  212.                 end
  213.                 when char = rxlv.scursorup & oldvar ~= 1 then do
  214.                     row = 1
  215.                     if oldrow = 1 then do
  216.                         if oldvar - rxlv.disprows < 1 then topvar = 1
  217.                         else topvar = oldvar - rxlv.disprows
  218.                         var = topvar
  219.                         call writech('listwin', rxlv.cls||getlighty(row, var)||rxlv.nl||getpage(topvar + 1))
  220.                     end
  221.                     else do
  222.                         var = topvar 
  223.                         call writech('listwin', getunlighty(oldrow, oldvar)||getlighty(row, var))
  224.                     end                
  225.                 end
  226.                 when char = rxlv.scursordown & oldvar ~= displine.0 then do
  227.                     row = rxlv.disprows
  228.                     if oldrow = rxlv.disprows then do
  229.                         if oldvar + rxlv.disprows > displine.0 then topvar = displine.0 - (rxlv.disprows - 1)
  230.                         else topvar = oldvar + 1
  231.                         var = min(displine.0, topvar + (rxlv.disprows - 1))
  232.                         call writech('listwin', rxlv.cls||getpage(topvar)||rxlv.nl||getlighty(row, var))
  233.                     end
  234.                     else do
  235.                         var = (topvar + rxlv.disprows) - 1
  236.                         call writech('listwin', getunlighty(oldrow, oldvar)||getlighty(row, var))
  237.                     end
  238.                 end
  239.                 otherwise nop
  240.             end
  241.         end
  242.         when char = rxlv.esc then do
  243.             call close('listwin')
  244.             return 0
  245.         end
  246.         when char = rxlv.cr then do
  247.             call close('listwin')
  248.             return oldvar
  249.         end
  250.         otherwise nop
  251.     end
  252. end
  253.  
  254. GETPAGE: procedure expose displine. rxlv.
  255. parse arg topvar
  256. if displine.0 = 1 then return ''
  257. page = ''
  258. do y = 1 to rxlv.disprows - 2                   /* Lines between first and last */
  259.     page = page||displine.topvar||rxlv.nl
  260.     topvar = topvar + 1
  261. end 
  262. page = page||displine.topvar                    /* No newline after last line */
  263. return page
  264.  
  265. GETUNLIGHTY: procedure expose rxlv. displine. 
  266. parse arg row, var .
  267. return rxlv.csi||row||';1H'||displine.var
  268.  
  269. GETLIGHTY: procedure expose rxlv. displine. 
  270. parse arg row, var .
  271. return rxlv.csi||row||';1H'||rxlv.hilite||displine.var||rxlv.off
  272.  
  273. INIT_RXLISTVIEW: procedure expose rxlv.
  274. /* Hardcoded minimum values */
  275. rxlv.width = max(100, arg(1))
  276. rxlv.height = max(50, arg(2))
  277.  
  278. /* ANSI stuff */
  279. rxlv.csi = '9b'x ; rxlv.esc = '1b'x
  280. rxlv.nl = '0a'x  ; rxlv.cr = '0d'x
  281. rxlv.off = rxlv.csi||'0m' 
  282. rxlv.topleft = rxlv.csi||'48'x 
  283. rxlv.cls = rxlv.csi||'H'||rxlv.csi'J'
  284. rxlv.hilite = rxlv.csi||'43;32m'
  285. rxlv.nowordwrap = rxlv.csi||'3f376c'x
  286. rxlv.nocursor = rxlv.csi||'302070'x 
  287. rxlv.cursorup = '41'x  ; rxlv.cursordown = '42'x 
  288. rxlv.scursorup = '54'x ; rxlv.scursordown = '53'x
  289.  
  290. /* GUI constants */
  291. guiheight = 7 ; guiwidth = 8
  292.  
  293. /* Font info */
  294. intui = showlist(l, 'intuition.library',, a)
  295. call forbid
  296. screen = next(intui, 56)                        /* IntuitionBase->ActiveScreen */
  297. font = next(screen, 136)                        /* Screen->RastPort.Font */
  298. fonty = c2d(import(offset(font, 20), 2))   /* Font->YSize */
  299. fontx = c2d(import(offset(font, 24), 2))   /* Font->XSize */
  300. call permit
  301.  
  302. /* Listview width */
  303. do while (rxlv.width - guiwidth) // fontx ~= 0 
  304.     rxlv.width = rxlv.width + 1 
  305. end
  306. rxlv.dispcols = ((rxlv.width - guiwidth) % fontx)
  307.  
  308. /* Listview height */
  309. const = guiheight + fonty
  310. do while (rxlv.height - const) // fonty ~= 0 
  311.     rxlv.height = rxlv.height + 1 
  312. end
  313. rxlv.disprows = (rxlv.height - const) % fonty
  314.  
  315. /* We only need to do all this once */
  316. rxlv.init? = 1
  317. return
  318.  
  319.  
  320. REPLACE: procedure
  321. parse arg src, new, old
  322. str = ''
  323. do while src ~= ''
  324.   chk = pos(old, src)
  325.   parse var src pre (old) src
  326.   str = str||pre
  327.   if chk > 0 then str = str||new
  328. end
  329. return str
  330.  
  331.  
  332. CHECKLF: procedure expose nl cr
  333. str = arg(1)
  334. if pos(nl, str) > 0 then str = replace(str, '\n', nl)
  335. if pos(cr, str) > 0 then str = replace(str, '\r', cr)
  336. return str
  337.  
  338. ADDLF: procedure expose nl cr
  339. str = arg(1)
  340. if pos('\n', str) > 0 then str = replace(str, nl, '\n')
  341. if pos('\r', str) > 0 then str = replace(str, cr, '\r')
  342. return str
  343.